PUBLICIDADE
Este código tem nota
5,5

Autor

francke

Francke Peixoto

membro deste setembro de 2007

Tags

Compartilhe e guarde

  • Rec6
  • StumbleUpon
  • ueba
  • linkk
  • dihitt
  • linkloko
  • linkto
  • Technorati
  • Simpy
  • del.icio.us
  • Faves: Fave It!

PUBLICIDADE

Enquete

Você acredita que um dia o Firefox será mais utilizado que o IE?

Papa Capim ICQ (CHAT)


Este bate papo foi escrito em ASP e se parece um pouco com o antigo ICQ.

Fácil de usar e instalar, só colocá-lo no servidor e usar. simples assim! :-)
<%
Response.Buffer = True
Response.AddHeader "cache-control", "private"
Response.AddHeader "pragma", "no-cache"
Response.ExpiresAbsolute = #January 1, 2004 00:00:01#
Response.Expires=0
%>
<META HTTP-EQUIV=Refresh CONTENT="25; URL=online.asp">
<%
if session("nick") = "" Then
	response.redirect("index.asp")
	response.end
end if
%>	

<!--#include file="cn.asp"-->
<!-- 
  DATA DE CRIAÇÃO: 02/06/2002
  AUTOR: FRANCKE PEIXOTO
  MSN/EMAIL: FRANCKE@XMASTERS.COM.BR
-->
<style>
<!--
.fonte  {
          font-family:verdana, arial; color:#000000; font-size:10px; font-weight:bold; background-color : #ffffff; border: 0px solid #000000
      } 

.fonteG  {
       font-family:verdana, arial; color:#000000; font-size:12px; font-weight:bold
      } 
.f  {
        font-family:verdana, arial; color:#000000; font-size:10px; font-weight:none; background-color : #D9FFD9; border: 1px solid #000000
      }      
-->
</style>
<script language="JavaScript" type="text/JavaScript">
<!--
function MM_openBrWindow(theURL,winName,features) { //v2.0
  window.open(theURL,winName,features);
}
//-->
</script>
<title>Usu&aacute;rios Online vers&atilde;o 0.01</title><IFRAME name=corpo align=left 
            marginWidth=0 marginHeight=0 src="mensagem.asp" 
            frameBorder=0 width=1 
  height=1></IFRAME>
<img src="logoP.gif">
<%
Const  AdOpenKeySet = -1
Const  AdLockOptimistic = 3	
Dim ip, logado, mysessao, rs, sql,  atualizar_logado 
ip = session("nick")
logado = now()
mysessao = Session.SessionID
%>
<HR color="#008040">
<%

dim cadastro
atualizar_logado = False
sql = 	"SELECT * From online"
Set rs = Server.CreateObject("ADODB.RECORDSET")
    rs.Open sql,cn,AdOpenKeySet,AdLockOptimistic 

   
    Do While Not rs.eof 
       if  (strComp(rs("sessao"), mysessao, vbTextCompare)= 0) Then
            atualizar_logado = True
            'response.write "1"
        else
            'response.write "2"                     
       end if 
       rs.MoveNext
    Loop  
                 
           if  atualizar_logado = False Then
                   inserir = "insert into online (sessao,data,ip) values('"&mysessao&"','"&logado&"','"&ip&"')"
               Set insere =cn.Execute(inserir)

           end if    
           
           if  atualizar_logado = True Then
               atualizar = "Update online set Data ='"&Now()&"' Where sessao ="&Trim(mysessao)&" "
               Set alterar = cn.Execute(atualizar)
               'response.write "esse atualiza"
           end if     

sql = 	"SELECT TOP 70 * From online Order by data Desc"
Set rs = Server.CreateObject("ADODB.RECORDSET")
    rs.Open sql,cn,AdOpenKeySet,AdLockOptimistic                
Dim tempo, conte
conte = 0               
    tempo = DateAdd("n", -1, now)
     response.write "<font class='fonteG'>Usuários Online:</font><br>"
   While not rs.eof
       if rs("data") > tempo then 
          'response.write rs("sessao")&"<br>"  
	
%>
	  <% if trim(rs("sessao")) <> trim(mysessao) then %>
<button onclick="MM_openBrWindow('msg.asp?msg=<%=rs("sessao")%>','','width=330,height=180');" class="fonte">  <img src="p.gif" border=0>
  <font class=fonte><%=rs("ip")%>  </button>
<hr class="fonte"></hr>
          <% end if %>
<%							
		conte = conte + 1
        else
          rs.delete         
       end if   
     rs.MoveNext
   Wend    
response.write "</a><br><img src='P.gif' border=0> <font class='fonte'>Total: </font><font class='fonte'><b>"&conte&"</b></font>" 
rs.close
%>
<form method="post" action="online.asp">
<input type="hidden" name="sair" value="sair">
<input type="submit" value="sair" class="f"></form>
<%
if Trim(request.Form("sair")) = "sair" then
	Ssql = 	"SELECT TOP 5 * From online Order by data Desc"
	Set Srs = Server.CreateObject("ADODB.RECORDSET")
            Srs.Open Ssql,cn,AdOpenKeySet,AdLockOptimistic    	
		Do While Not Srs.eof
			if Trim(srs("sessao")) = Trim(mysessao) Then
				srs.delete
				session("nick") = ""	
				Session.Abandon()	
				response.redirect("index.asp")
			end if
		 	srs.MoveNext	
		Loop
		srs.close
end if		
Set srs = nothing				
Set rs = nothing
Set cn = nothing
set alterar = nothing
set cadastro = nothing

%>
<hr color="#008040">
<font face="verdana" size="1" color="#000">
by Francke Peixoto</font>

ArquivoTipoTamanhoHits 
CHAT - Papa Capim ICQ.zipArquivo ZIP41,5 Kb1039Baixar o Arquivo
Sim   Não   Este código foi útil para você?
NotaComentário
10
francke comentou em 2/2/2009

bloqueador de popup ativo

esse é o problema! ;-)
1
piobox comentou em 30/1/2009

nao funcionou !

boa noite gostei da ideia, mas o arquivo zip nao bare, quando tento abrir com o winzip ele redireciona pra pagina denovo.
Regras:
Os comentários seguem as seguintes regras:
  • Todos os comentários são enviados por membros cadastrados no site.
  • A pontuação de comentários de conteúdo do próprio membro não serão computados.
  • Os comentários serão pré-aprovados, porém a equipe do site revisará o conteúdo de todos os comentários podendo ser invalidados (inclusive a pontuação).
  • Os comentários precisam ter, obrigatóriamente, coerência sobre o conteúdo que será comentado.
  • O membro que atingir 5 comentários invalidados não poderá mais comentar dentro do site. Com isso o membro não poderá mais ganhar pontos com comentários.
  • Há um limite de 10 comentários por dia para cada membro.
  • Qualquer comentário após ter sido publicado poderá ser retirado através da opção ( denunciar)

Comente

     (ainda não tem cadastro? clique aqui!)


Máximo de 30 caracteres

Máximo de 255 caracteres
 

R&W Consulting - Soluções Web Hospedagem UOL HOST PagSeguro - solução para pagamentos online
© 2006-2009 R&W Informática Ltda. - Todos os direitos reservados.